perm filename UNBRAC.1[AID,LSP] blob sn#265940 filedate 1977-02-17 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(declare (fixnum i cnt n))
C00004 ENDMK
C⊗;
(declare (fixnum i cnt n))

(macrodef select-disk (x)
	((lambda (↑R ↑W ↑Q eof linel)
		x) t t t -1 132))
 
(macrodef push (x y)
	(setq y (cons x y)))
 
(macrodef pop (x y)
	(setq x (car y)
	      y (cdr y)))
 
(macrodef incr (n)
	(setq n (1+ n)))
 
(macrodef dcr (n)
	(setq n (1- n)))
 
(macrodef set-one (n)
	(setq n 1))

(macrodef write (n)
	(do ((i n (1- i))) ((zerop i))
		(tyo 51)))
 
(defun unbracket fexpr (file)
	(prog (pdl cnt)
	 (setq cnt 0)
	 (apply 'eread file)
	 (uwrite)
	 (select-disk
		(do ((i (tyi eof)(tyi eof)))
		    ((= i eof))
			(cond ((or (= i 15)(= i 12)) (terpri)(tyi))
			      ((= i 133)
				(push cnt pdl)
				(set-one cnt)
				(tyo 50))
			      ((= i 135)
				(write cnt)
				(pop cnt pdl))
			      ((= i 50)
				(incr cnt) (tyo i))
			     ((= i 51) (dcr cnt) (tyo i))
			     ((= i 32)(tyo 73)(tyo 73))
			     ((= i 42)(tyo 174))
			     ((= i 100)(tyo 47))
			     (t (tyo i)))))
	 (return (apply 'ufile (list (car file) 'mcl)))))